home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 5 Developer's Kit / vb5 dev kit.iso / dev / f1ocx / vcform1.3 / VB4 / SSMDI / FINDDLG.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-09-15  |  10.2 KB  |  283 lines
  1. VERSION 4.00
  2. Begin VB.Form FindDlg 
  3.    Caption         =   "Find"
  4.    ClientHeight    =   2025
  5.    ClientLeft      =   375
  6.    ClientTop       =   645
  7.    ClientWidth     =   7185
  8.    BeginProperty Font 
  9.       name            =   "MS Sans Serif"
  10.       charset         =   0
  11.       weight          =   700
  12.       size            =   8.25
  13.       underline       =   0   'False
  14.       italic          =   0   'False
  15.       strikethrough   =   0   'False
  16.    EndProperty
  17.    Height          =   2430
  18.    Icon            =   "FindDlg.frx":0000
  19.    Left            =   315
  20.    LinkTopic       =   "Form1"
  21.    ScaleHeight     =   2025
  22.    ScaleWidth      =   7185
  23.    Top             =   300
  24.    Width           =   7305
  25.    Begin VB.TextBox FindText 
  26.       BeginProperty Font 
  27.          name            =   "MS Sans Serif"
  28.          charset         =   0
  29.          weight          =   700
  30.          size            =   9.75
  31.          underline       =   0   'False
  32.          italic          =   0   'False
  33.          strikethrough   =   0   'False
  34.       EndProperty
  35.       Height          =   375
  36.       Left            =   120
  37.       TabIndex        =   9
  38.       Top             =   480
  39.       Width           =   5415
  40.    End
  41.    Begin VB.CommandButton CloseButton 
  42.       BackColor       =   &H80000005&
  43.       Caption         =   "Close"
  44.       Height          =   375
  45.       Left            =   5880
  46.       TabIndex        =   8
  47.       Top             =   720
  48.       Width           =   1215
  49.    End
  50.    Begin VB.CommandButton FindButton 
  51.       BackColor       =   &H80000005&
  52.       Caption         =   "Find Next"
  53.       Height          =   375
  54.       Left            =   5880
  55.       TabIndex        =   7
  56.       Top             =   120
  57.       Width           =   1215
  58.    End
  59.    Begin VB.CheckBox EntireCell 
  60.       Caption         =   "Entire Cells Only"
  61.       Height          =   255
  62.       Left            =   3120
  63.       TabIndex        =   6
  64.       Top             =   1440
  65.       Width           =   1815
  66.    End
  67.    Begin VB.CheckBox MatchCase 
  68.       Caption         =   "Match Case"
  69.       Height          =   255
  70.       Left            =   3120
  71.       TabIndex        =   5
  72.       Top             =   1080
  73.       Width           =   1575
  74.    End
  75.    Begin VB.ComboBox LookCombo 
  76.       Height          =   315
  77.       Left            =   1320
  78.       Style           =   2  'Dropdown List
  79.       TabIndex        =   1
  80.       Top             =   1560
  81.       Width           =   1455
  82.    End
  83.    Begin VB.ComboBox SearchCombo 
  84.       Height          =   315
  85.       Left            =   1320
  86.       Style           =   2  'Dropdown List
  87.       TabIndex        =   0
  88.       Top             =   1080
  89.       Width           =   1455
  90.    End
  91.    Begin VB.Label Label3 
  92.       Caption         =   "Look In:"
  93.       Height          =   255
  94.       Left            =   240
  95.       TabIndex        =   4
  96.       Top             =   1560
  97.       Width           =   975
  98.    End
  99.    Begin VB.Label Label2 
  100.       Caption         =   "Search:"
  101.       Height          =   255
  102.       Left            =   240
  103.       TabIndex        =   3
  104.       Top             =   1080
  105.       Width           =   975
  106.    End
  107.    Begin VB.Label Label1 
  108.       Caption         =   "Find What"
  109.       BeginProperty Font 
  110.          name            =   "MS Sans Serif"
  111.          charset         =   0
  112.          weight          =   700
  113.          size            =   9.75
  114.          underline       =   0   'False
  115.          italic          =   0   'False
  116.          strikethrough   =   0   'False
  117.       EndProperty
  118.       Height          =   255
  119.       Left            =   120
  120.       TabIndex        =   2
  121.       Top             =   120
  122.       Width           =   2055
  123.    End
  124. Attribute VB_Name = "FindDlg"
  125. Attribute VB_Creatable = False
  126. Attribute VB_Exposed = False
  127. Option Explicit
  128. Private Sub CloseButton_Click()
  129.    FindDlg.Hide
  130. End Sub
  131. Private Sub FindButton_Click()
  132.    Call FindData
  133. End Sub
  134. Private Sub FindData()
  135.    Dim LastRow%, LastCol%
  136.    Dim TheRow%, TheCol%, TheType%
  137.    Dim StartRow%, StartCol%
  138.    Dim X1&, Y1&, X2&, Y2&
  139.    Dim CellVisible%
  140.    Dim ssError%
  141.    '' This procedure searches the worksheet for the specified
  142.    '' text.  It only searches the current page (tab).
  143.    If SSIsActiveForm() Then
  144.       TheRow = MainFrame.ActiveForm.SS.Row
  145.       TheCol = MainFrame.ActiveForm.SS.Col
  146.       StartRow = TheRow
  147.       StartCol = TheCol
  148.       LastRow = MainFrame.ActiveForm.SS.LastRow
  149.       LastCol = MainFrame.ActiveForm.SS.LastCol
  150.       '' Make sure there is data in the worksheet
  151.       If LastRow = 0 Then
  152.          MsgBox "No data in the spreadsheet."
  153.          MainFrame.ActiveForm.SS.SetFocus
  154.          Exit Sub
  155.       End If
  156.       '' Search the worksheet by rows
  157.       If SearchCombo.ListIndex = 0 Then
  158.          TheCol = TheCol + 1  ' Skip the column we are in
  159.          '' Keep cycling through the rows one at a time
  160.          Do
  161.             '' Get the last column in this row (so we don't search all columns)
  162.             LastCol = MainFrame.ActiveForm.SS.LastColForRow(TheRow)
  163.             '' Search all the cells from the current one to the last one in this row
  164.             Do While TheCol <= LastCol
  165.                '' See if we searched the whole worksheet
  166.                If TheRow = StartRow And TheCol = StartCol Then
  167.                   MsgBox "Data not found."
  168.                   MainFrame.ActiveForm.SS.SetFocus
  169.                   Exit Sub
  170.                End If
  171.                '' Check this cell for a match
  172.                TheType = MainFrame.ActiveForm.SS.TypeRC(TheRow, TheCol)
  173.                If MatchCell(TheRow, TheCol, TheType) Then
  174.                   '' Data was found
  175.                   MainFrame.ActiveForm.SS.SetFocus
  176.                   '' If cell is not visible then move the sheet so it is in the upper left
  177.                   MainFrame.ActiveForm.SS.RangeToTwips TheRow, TheCol, TheRow, TheCol, X1, Y1, X2, Y2, CellVisible
  178.                   If CellVisible <> 1 Then
  179.                      MainFrame.ActiveForm.SS.TopRow = IIf(TheRow > 1, TheRow - 1, 1)
  180.                      MainFrame.ActiveForm.SS.LeftCol = IIf(TheCol > 1, TheCol - 1, 1)
  181.                   End If
  182.                   Exit Sub
  183.                End If
  184.                TheCol = TheCol + 1
  185.             Loop
  186.             '' Next Row - If we are at the end then start back at the top
  187.             TheCol = 1
  188.             TheRow = IIf(TheRow < LastRow, TheRow + 1, 1)
  189.          Loop
  190.       Else  '' Search by columns
  191.          TheRow = TheRow + 1  '' Skip the row we are in
  192.          '' Keep cycling through the columns one at a time
  193.          Do
  194.             '' Search all the cells from the current one to the last one in this column
  195.             Do While TheRow <= LastRow
  196.                '' See if we searched the whole worksheet
  197.                If TheRow = StartRow And TheCol = StartCol Then
  198.                   MsgBox "Data not found."
  199.                   MainFrame.ActiveForm.SS.SetFocus
  200.                   Exit Sub
  201.                End If
  202.                '' Check this cell for a match
  203.                TheType = MainFrame.ActiveForm.SS.TypeRC(TheRow, TheCol)
  204.                If MatchCell(TheRow, TheCol, TheType) Then
  205.                   MainFrame.ActiveForm.SS.SetFocus
  206.                   '' If cell is not visible then move the sheet so it is in the upper left
  207.                   MainFrame.ActiveForm.SS.RangeToTwips TheRow, TheCol, TheRow, TheCol, X1, Y1, X2, Y2, CellVisible
  208.                   If CellVisible <> 1 Then
  209.                      MainFrame.ActiveForm.SS.TopRow = IIf(TheRow > 1, TheRow - 1, 1)
  210.                      MainFrame.ActiveForm.SS.LeftCol = IIf(TheCol > 1, TheCol - 1, 1)
  211.                   End If
  212.                   Exit Sub
  213.                End If
  214.                TheRow = TheRow + 1
  215.             Loop
  216.             '' Next Column - If we are at the end then start back at the left
  217.             TheRow = 1
  218.             TheCol = IIf(TheCol < LastCol, TheCol + 1, 1)
  219.          Loop
  220.       End If
  221.    End If
  222. End Sub
  223. Private Sub FindText_KeyPress(KeyAscii As Integer)
  224.    If KeyAscii = 13 Then      '' Enter has been pressed
  225.       Call FindData
  226.       KeyAscii = 0
  227.    End If
  228. End Sub
  229. Private Sub Form_GotFocus()
  230.    FindText.SetFocus
  231. End Sub
  232. Private Sub Form_Load()
  233.    SearchCombo.AddItem "By Rows"      '' Initialize the data in the combo
  234.    SearchCombo.AddItem "By Columns"   '' boxes for the find dialog box
  235.    SearchCombo.ListIndex = 0          '' The inital settings will be to
  236.                                       '' search by rows through text
  237.    LookCombo.AddItem "Text"
  238.    LookCombo.AddItem "Numbers"
  239.    LookCombo.ListIndex = 0
  240. End Sub
  241. Private Function MatchCell%(TheRow%, TheCol%, TheType%)
  242.    '' This function returns a value telling if the data to be found and
  243.    '' the data in the current row and column match one another
  244.    Dim ssError%
  245.    '' Test number cells  or formulas returning numbers
  246.    '' Test to two decimal places
  247.    If LookCombo.ListIndex = 1 And Abs(TheType) = 1 Then
  248.       MainFrame.ActiveForm.SS.Row = TheRow
  249.       MainFrame.ActiveForm.SS.Col = TheCol
  250.       If Int((MainFrame.ActiveForm.SS.Number + 0.001) * 100) = Int((Val(FindText.TEXT) + 0.001) * 100) Then
  251.          MatchCell = True
  252.          Exit Function
  253.       End If
  254.       '' Test Text or text results of formulas
  255.    ElseIf LookCombo.ListIndex = 0 And Abs(TheType) = 2 Then
  256.       MainFrame.ActiveForm.SS.Row = TheRow
  257.       MainFrame.ActiveForm.SS.Col = TheCol
  258.       '' Match any part of the cell
  259.       If EntireCell.VALUE = 0 Then
  260.          If InStr(1, MainFrame.ActiveForm.SS.TEXT, FindText.TEXT, IIf(MatchCase.VALUE = 0, 1, 0)) Then
  261.             MatchCell = True
  262.             Exit Function
  263.          End If
  264.       '' Match the whole cell
  265.       Else
  266.          '' Match case exactly
  267.          If MatchCase.VALUE = 1 Then
  268.             If MainFrame.ActiveForm.SS.TEXT = FindText.TEXT Then
  269.                MatchCell = True
  270.                Exit Function
  271.             End If
  272.          '' Match regardless of case
  273.          Else
  274.             If UCase(MainFrame.ActiveForm.SS.TEXT) = UCase(FindText.TEXT) Then
  275.                MatchCell = True
  276.                Exit Function
  277.             End If
  278.          End If
  279.       End If
  280.    End If
  281.    MatchCell = False
  282. End Function
  283.